home *** CD-ROM | disk | FTP | other *** search
- // System Includes
- #include <stdlib.h>
- #include <stdio.h>
- #include <string.h>
- #include <sys/types.h>
- #include <errno.h>
-
- #if defined(_EVEREST) || defined(_SUNOS5)
-
- #include <sys/select.h>
- #include <ulimit.h>
- //#include <strings.h>
-
- // Needs ulimit and select
-
- #endif
-
- #ifdef _WINDOWS
-
- #include <winsock.h>
- #include <process.h>
-
- #else
-
- #include <unistd.h>
- #include <sys/socket.h>
- #include <netinet/in.h>
- #include <netinet/tcp.h>
- #include <arpa/inet.h>
- #include <netdb.h>
-
- #endif
-
- #include "OtclOserver.H"
- #include "Otcl.H"
- #include "OtclError.H"
- #include "OtclObject.H"
-
- #ifdef _SUNOS4
- #include "sunos4.h"
- #endif
-
- #ifdef _SUNOS5
- #include <sys/systeminfo.h>
- #define GETHOSTNAME(b,l) sysinfo(SI_HOSTNAME,(b),(l))
- #else
- #define GETHOSTNAME(b,l) gethostname((b),(l))
- #endif
-
- #ifdef _WINDOWS
-
- #define FD_SIZE FD_SETSIZE
- #define CLOSE_SOCKET(s) closesocket(s)
-
- #else
-
- #define FD_SIZE ulimit(4,0)
- #define CLOSE_SOCKET(s) close(s)
-
- #endif
-
- // Static Class Attributes
- fd_set *OtclOserver::incommingFdSet = new fd_set;
- fd_set *OtclOserver::incommingFdSubset = new fd_set;
- OtclChannel **OtclOserver::incommingChannel = (OtclChannel**)malloc((unsigned int)FD_SIZE * sizeof(OtclChannel*));
-
- OtclChannel *OtclOserver::listener = NULL;
- char **OtclOserver::incommingThread = (char**)malloc((unsigned int)FD_SIZE *
- sizeof(char*));
- char *OtclOserver::currentThread = OtclOserver::createOurThreadId();
- void (*OtclOserver::addReadFd) (int) = NULL;
- void (*OtclOserver::rmvReadFd) (int) = NULL;
- Tcl_HashTable *OtclOserver::outgoingChannel = NULL;
- char *OtclOserver::address = NULL;
-
- OtclChannel::OtclChannel (char *addrStr, Tcl_Interp *interp, int &result)
- {
- extern int errno;
- extern int sys_nerr;
- extern char *sys_errlist[];
-
- skt = -1;
- result = TCL_OK;
-
- char *colon = strchr(addrStr,':');
- if (colon == NULL)
- {
- result = TCL_ERROR;
- Otcl::setTclResult(interp,ADDRESS_NO_COLON_ERR,addrStr);
- return;
- }
-
- *colon = NULL;
- char *host = addrStr;
- int port = atoi(colon+1);
-
- if (port == 0)
- {
- result = TCL_ERROR;
- Otcl::setTclResult(interp,ADDRESS_INVALID_PORT_ERR,addrStr);
- *colon = ':';
- return;
- }
-
- skt = socket(AF_INET,SOCK_STREAM,0);
- if (skt == -1)
- {
- result = TCL_ERROR;
- Otcl::setTclResult(interp,COULDNT_SOCKET_ERR,(errno > sys_nerr ?
- "- unknown reason" : sys_errlist[errno]));
- *colon = ':';
- return;
- }
-
- struct hostent *hp = gethostbyname(host);
- if (hp == NULL)
- {
- result = TCL_ERROR;
- Otcl::setTclResult(interp,COULDNT_GET_HOSTNAME_ERR,host);
- CLOSE_SOCKET(skt);
- skt = -1;
- *colon = ':';
- return;
- }
-
- struct sockaddr_in address;
- address.sin_family = AF_INET;
- address.sin_port = htons(port);
- memcpy(&address.sin_addr,hp->h_addr_list[0],hp->h_length);
-
- if (connect(skt,(sockaddr*)&address,sizeof(address)) == -1)
- {
- result = TCL_ERROR;
- Otcl::setTclResult(interp,COULDNT_CONNECT_ERR,addrStr,(errno > sys_nerr ?
- "- unknown reason" : sys_errlist[errno]));
- CLOSE_SOCKET(skt);
- skt = -1;
- *colon = ':';
- return;
- }
-
- *colon = ':';
- }
-
- OtclChannel::OtclChannel (int fd)
- {
- skt = fd;
- }
-
- OtclChannel::~OtclChannel ()
- {
- if (skt != -1)
- {
- CLOSE_SOCKET(skt);
- }
- }
-
- int OtclChannel::sendFull (char *buffer, int length)
- {
- int totalBytesSent = 0;
- int bytesSent = 0;
- while (totalBytesSent != length)
- {
- bytesSent = ::send(skt,buffer,length,0);
- if (bytesSent == -1 || bytesSent == 0)
- {
- return -1;
- }
- totalBytesSent += bytesSent;
- }
- return 0;
- }
-
- int OtclChannel::recvFull (char *buffer, int length)
- {
- int totalBytesRecv = 0;
- int bytesRecv = 0;
- while (totalBytesRecv < length)
- {
- bytesRecv = ::recv(skt,buffer,length,0);
- if (bytesRecv == -1 || bytesRecv == 0)
- {
- return -1;
- }
- totalBytesRecv += bytesRecv;
- }
- return 0;
- }
-
- int OtclChannel::streamOut (char c)
- {
- return sendFull(&c,1);
- }
-
- int OtclChannel::streamOut (long l)
- {
- long tmp = htonl(l);
- return sendFull((char*)&tmp,sizeof(long));
- }
-
- int OtclChannel::streamOutNullTerminated (char *s)
- {
- long length = (s == NULL? -1 : strlen(s));
- if (streamOut(length) == -1)
- {
- return -1;
- }
- if (length >= 0)
- {
- return sendFull(s,(int)length);
- }
- return 0;
- }
-
- int OtclChannel::streamIn (char &c)
- {
- char *cptr = &c;
- return recvFull(cptr,1);
- }
-
- int OtclChannel::streamIn (long &l)
- {
- long nl;
- int result = recvFull((char*)&nl,sizeof(long));
- l = ntohl(nl);
- return result;
- }
-
- int OtclChannel::streamInNullTerminated (char *&s)
- {
- long length;
- if (streamIn(length) == -1)
- {
- return -1;
- }
-
- if (length >= 0)
- {
- s = (char*)malloc((unsigned int) ((length + 1) * sizeof(char)));
- if (recvFull(s,(int)length) == -1)
- {
- free(s);
- return -1;
- }
- s[length] = NULL;
- }
- else
- {
- s = NULL;
- }
-
- return 0;
- }
-
- int OtclChannel::operator == (int fd)
- {
- if (skt == fd)
- {
- return OTCL_TRUE;
- }
- else
- {
- return OTCL_FALSE;
- }
- }
-
- int OtclChannel::getFd (void)
- {
- return skt;
- }
-
-
- int OtclOserver::initialiseCmd (Tcl_Interp *interp, int argc, char *argv[])
- {
- ARGC_RANGE(3,5)
- {
- return Otcl::setTclError(interp,ARGS_OSERVER_INIT_ERR);
- }
-
- if (listener != NULL)
- {
- return Otcl::setTclError(interp,OTCL_OSERVER_ALREADY_INIT_ERR);
- }
-
- int minPort = -1;
- int maxPort = -1;
-
- if (argc > 3)
- {
- minPort = atoi(argv[3]);
- if (minPort < 0)
- {
- return Otcl::setTclError(interp,OTCL_OSERVER_MIN_PORT_ERR);
- }
- }
- if (argc == 5)
- {
- maxPort = atoi(argv[4]);
- if (maxPort < minPort)
- {
- return Otcl::setTclError(interp,OTCL_OSERVER_MAX_PORT_ERR);
- }
- }
-
- if (minPort == -1)
- {
- // No port or range of ports specified, use default
- // range
- minPort = MIN_TCP_IP_PORT;
- maxPort = MAX_TCP_IP_PORT;
- }
-
- int skt = socket(AF_INET,SOCK_STREAM,0);
- if (skt == -1)
- {
- return Otcl::setTclError(interp,COULDNT_SOCKET_ERR);
- }
-
- struct sockaddr_in bindAddr;
- memset(&bindAddr,NULL,sizeof(bindAddr));
- bindAddr.sin_family = AF_INET;
- bindAddr.sin_addr.s_addr = htonl(INADDR_ANY);
-
- int port;
- if (maxPort == -1)
- {
- bindAddr.sin_port = htons(minPort);
- if (::bind(skt,(struct sockaddr *)&bindAddr,sizeof(bindAddr)) == -1)
- {
- CLOSE_SOCKET(skt);
- return Otcl::setTclError(interp,CANNOT_BIND_TO_PORT_ERR,minPort);
- }
- port = minPort;
- }
- else
- {
- port = minPort;
- do
- {
- port++;
- bindAddr.sin_port = htons(port);
- }
- while (port <= maxPort && ::bind(skt,(struct sockaddr *)&bindAddr,
- sizeof(bindAddr)) == -1);
- if (port > maxPort)
- {
- CLOSE_SOCKET(skt);
- return Otcl::setTclError(interp,NO_AVAILABLE_PORTS_ERR,minPort,
- maxPort);
- }
- }
-
- ::listen(skt,5);
- listener = new OtclChannel(skt);
- FD_ZERO(incommingFdSet);
- FD_ZERO(incommingFdSubset);
- FD_SET(skt,incommingFdSet);
- FD_SET(skt,incommingFdSubset);
-
- // Maybe an issue with fdset not being cleared if we aren't a server!
- // TO DO tink about
-
- if (addReadFd != NULL)
- {
- // The client code is providing its own main loop
- // inform it of the new Fd to watch out for
- (*addReadFd)(skt);
- }
-
- char suffix[128];
- char name[128];
- GETHOSTNAME(name,128);
- hostent *he = gethostbyname(name);
- if (he)
- {
- strcpy(name,he->h_name);
- }
- sprintf(suffix,"@%s:%d",name,port);
- Otcl::otclPtr->setObjectReferenceSuffix(suffix);
-
- // We don't need to '@' in our internal address
- address = (char*)malloc(strlen(suffix) * sizeof(char));
- sprintf(address,"%s:%d",name,port);
-
- // Initialise incomming threads and channels.
- int l = (int)FD_SIZE;
- for (int i = 0; i < l; i++)
- {
- incommingThread[i] = NULL;
- incommingChannel[i] = NULL;
- }
- incommingChannel[skt] = listener;
-
-
- Otcl::setTclResult(interp,"%d",port);
- return TCL_OK;
- }
-
- void OtclOserver::readableFd (int fd)
- {
- if (listener != NULL && (listener->getFd() == fd))
- {
- // new client connection. Accept the connection and give it
- // a channel, register the new client channel with the main
- // loop for read events.
-
- int a = 55;
- a++;
- processConnectionRequest();
- a++;
- return;
- }
-
- OtclChannel *channel = incommingChannel[fd];
- if (channel != NULL)
- {
- // stack current thread id.
- char *oldThreadId = currentThread;
- currentThread = NULL;
-
- if (incommingThread[fd] != NULL)
- {
- // We have already read the thread id from the channel
- // and it was stored in incommingThread[fd]
- currentThread = incommingThread[fd];
- incommingThread[fd] = NULL;
-
- // The fd will have been removed from the fdSubset, so put it back
- FD_SET(fd,incommingFdSubset);
- }
- else if (channel->streamInNullTerminated(currentThread) == -1)
- {
- // Problem with channel. Clean it up and de-register our
- // interest. Probably a client disconnected.
- cleanupIncommingChannel(fd);
- currentThread = NULL; // Just in case the read garbaged it!
- }
-
- if (currentThread != NULL)
- {
- processRequest(fd,Otcl::tclInterp);
-
- free(currentThread);
- }
-
- // restore the stacked thread id.
- currentThread = oldThreadId;
- }
- }
-
- int OtclOserver::oserverCmd (Tcl_Interp *interp, int argc, char *argv[])
- {
- ARGC_MIN(3)
- {
- return Otcl::setTclError(interp,ARGS_OSERVER_INIT_ERR);
- }
-
- if (strcmp("init",argv[2]) == 0)
- {
- return initialiseCmd(interp,argc,argv);
- }
-
- if (strcmp("process",argv[2]) == 0)
- {
- return processCmd(interp,argc,argv);
- }
-
- if (strcmp("getAddress",argv[2]) == 0)
- {
- return getAddressCmd(interp,argc,argv);
- }
-
- return Otcl::setTclError(interp,UNKNOWN_OSERVER_COMMAND_ERR,argv[2]);
- }
-
- int OtclOserver::processCmd (Tcl_Interp *interp, int argc, char *argv[])
- {
- ARGC_RANGE(3,4)
- {
- return Otcl::setTclError(interp,ARGS_OSERVER_PROCESS_ERR);
- }
-
- if (listener == NULL)
- {
- return Otcl::setTclError(interp,OTCL_OSERVER_MUST_INIT_FIRST_ERR);
- }
-
- char *script = (argc == 4? argv[3] : NULL);
- int scriptResult = TCL_OK;
- int finished = OTCL_FALSE;
- int result;
- fd_set selectSet;
- int available;
- int maxFds = (int)FD_SIZE;
- do
- {
-
- // select on all outer descriptors
- selectSet = *incommingFdSet;
- available = select(maxFds,&selectSet,NULL,NULL,0);
- if (available == -1 || available == 0)
- {
- result = TCL_ERROR;
- finished = OTCL_TRUE;
- Otcl::setTclResult(interp,OTCL_OSERVER_SELECT_ERR);
- }
- else
- {
- int fd = 0;
- while (available != 0)
- {
- if (FD_ISSET(fd,&selectSet))
- {
- available--;
- readableFd(fd);
- }
- fd++;
- }
- }
-
- if (script != NULL)
- {
- result = Tcl_Eval(interp,script);
- if (result == TCL_ERROR)
- {
- finished = OTCL_TRUE;
- }
- else
- {
- if (interp->result == NULL || strcmp(interp->result,"0") == 0)
- {
- finished = OTCL_TRUE;
- }
- }
- }
- }
- while (finished == OTCL_FALSE);
-
- return result;
- }
-
- int OtclOserver::getAddressCmd (Tcl_Interp *interp, int argc, char *[])
- {
- ARGC_VALUE(3)
- {
- return Otcl::setTclError(interp,ARGS_OTCL_OSERVER_GET_ADDRESS_ERR);
- }
-
- if (address != NULL)
- {
- Tcl_SetResult(interp,address,TCL_STATIC);
- }
- else
- {
- Tcl_SetResult(interp,"",TCL_STATIC);
- }
-
- return TCL_OK;
- }
-
- char *OtclOserver::createOurThreadId (void)
- {
- // The thread id for this process is made up of the
- // hostname:pid
- char hostname[128];
- char threadId[128];
- GETHOSTNAME(hostname,128);
- struct hostent *hp = gethostbyname(hostname);
- if (hp)
- {
- strcpy(hostname,hp->h_name);
- }
- sprintf(threadId,"%s:%d",hostname,getpid());
-
- return strdup(threadId);
- }
-
- OtclResponse *OtclOserver::sendRequest (Tcl_Interp *interp,
- char *address,
- OtclRequest *rqst)
- {
- // Find, or make a channel
- OtclChannel *channel;
- if (outgoingChannel == NULL)
- {
- // The outgoing channel hash table hasn't been created, so create it
- outgoingChannel = new Tcl_HashTable;
- Tcl_InitHashTable(outgoingChannel,TCL_STRING_KEYS);
- }
- int newEntry;
- Tcl_HashEntry *he = Tcl_CreateHashEntry(outgoingChannel,address,&newEntry);
- if (newEntry)
- {
- int result;
- channel = new OtclChannel(address,interp,result);
- if (result != TCL_OK)
- {
- // Has an error constructing the channel
- delete channel;
- return new OtclResponse(result,interp);
- }
- Tcl_SetHashValue(he,channel);
- }
- else
- {
- channel = (OtclChannel*)Tcl_GetHashValue(he);
- }
-
- // Stream out current thread id
- if (channel->streamOutNullTerminated(currentThread) == -1)
- {
- // Error streaming out the current thread id
- delete channel;
- Tcl_DeleteHashEntry(he);
- return new OtclResponse(TCL_ERROR,"Outgoing connection error.");
- }
-
- // stream out request object
- if (rqst->streamOut(channel) == -1)
- {
- // Error streaming out request
- delete channel;
- Tcl_DeleteHashEntry(he);
- return new OtclResponse(TCL_ERROR,"Outgoing connection error.");
- }
-
- fd_set readSet;
- int available;
- int maxFds = (int)FD_SIZE;
-
- do
- {
-
- // We want to look for a reply from the request channel and keep
- // an eye out for any other requests on the input channels that
- // haven't got a request queued up because it's for the wrong thread id.
- readSet = *incommingFdSubset;
- FD_SET(channel->getFd(),&readSet);
-
- available = select(maxFds,&readSet,NULL,NULL,0);
-
- if (available == 0)
- {
- // We timed out, how I don't know but we timed out!
- return new OtclResponse(TCL_ERROR,"Error in select loop");
- }
-
- if (available == -1)
- {
- if (available == EINTR)
- {
- // A signal broke our select, restart the select
- continue;
- }
-
- // We have had a real error
- return new OtclResponse(TCL_ERROR,"Error in select loop");
- }
-
- // There are 1 or more descriptors available
-
- if (FD_ISSET(channel->getFd(),&readSet))
- {
- // We have our reply. Break out of loop
- break;
- }
-
- // Iterate over incomming channels
- int i = 0;
- while (i < maxFds && available > 0)
- {
-
- if (incommingChannel[i] != NULL && FD_ISSET(i,&readSet))
- {
- available--;
-
- if (incommingChannel[i] == listener)
- {
- processConnectionRequest();
- }
- else
- {
- // A channel that isn't our listener has something pending
- // Read the thread id.
- if (incommingChannel[i]->streamInNullTerminated(
- incommingThread[i]) == -1)
- {
- // Error on the channel. Close down the channel and
- // de-register it from all of the fd sets.
- cleanupIncommingChannel(i);
- }
- if (strcmp(incommingThread[i],currentThread) == 0)
- {
- // The request is for the current thread so process it
- free(incommingThread[i]);
- incommingThread[i] = NULL;
- processRequest(i,interp);
- }
- else
- {
- // The incomming request is for a different thread
- // Request will be queued by removing the channel from the
- // incommingFdSubset. The request thread id has been placed
- // in the appropriate incommingThread[x] slot
- FD_CLR((unsigned int)i,incommingFdSubset);
- }
- }
- }
-
- i++;
- }
-
- }
- while (OTCL_TRUE);
-
- // The only way out of the above loop is for the original request
- // to have been replied to.
-
- // Read in response from channel
- OtclResponse *response = new OtclResponse();
- if (response->streamIn(channel) == -1)
- {
- // Error on the channel. Didn't get the request back.
- delete response;
- response = new OtclResponse(TCL_ERROR,"Error on channel before response.");
- }
-
- return response;
- }
-
- void OtclOserver::processRequest (int fd, Tcl_Interp *interp)
- {
- // read the type
- char requestType;
- OtclChannel *channel = incommingChannel[fd];
- if (channel->streamIn(requestType) == -1)
- {
- // Channel hasn an error, close it
- cleanupIncommingChannel(fd);
- }
- else
- {
- // Create the appropriate request type;
- OtclRequest *request;
- switch (requestType)
- {
- case INSTANCE_METHOD_RQST:
- request = new OtclInstanceMethodRqst();
- break;
-
- case DELETE_OBJECT_RQST:
- request = new OtclDeleteObjectRqst();
- break;
-
- case CLASS_METHOD_RQST:
- request = new OtclClassMethodRqst();
- break;
-
- case NEW_OBJECT_RQST:
- request = new OtclNewObjectRqst();
- break;
-
- default:
- // Nasty error, unknown message type, TO DO
- return;
- }
-
- // Stream in the request
- if (request->streamIn(channel) == -1)
- {
- cleanupIncommingChannel(fd);
- delete request;
- }
- else
- {
- // Perform the request and record the result;
- OtclResponse response(request->perform(interp),interp);
-
- // Stream out the response
- delete request;
- if (response.streamOut(channel) == -1)
- {
- cleanupIncommingChannel(fd);
- }
- }
- }
- }
-
- void OtclOserver::cleanupIncommingChannel (int fd)
- {
- delete incommingChannel[fd];
- FD_CLR((unsigned int)fd,incommingFdSet);
- FD_CLR((unsigned int)fd,incommingFdSubset);
- if (rmvReadFd != NULL)
- {
- // There is an outer loop registered beyond Object Tcl
- // inform it that we no longer need to monitor this channel.
- (*rmvReadFd)(fd);
- }
- }
-
- void OtclOserver::processConnectionRequest (void)
- {
- struct sockaddr_in clientAddr;
- int clientAddrLen = sizeof(clientAddr);
-
- // Should probably hide this inside OtclChannel. TO DO
- int client = ::accept(listener->getFd(),(struct sockaddr*)&clientAddr,&clientAddrLen);
- if (client == -1)
- {
- // This can only be a really hard error
-
- perror("OtclOserver:: listening socket accept error ");
-
- exit(1);
- }
-
- incommingChannel[client] = new OtclChannel(client);
- FD_SET(client,incommingFdSet);
- FD_SET(client,incommingFdSubset);
-
- if (addReadFd != NULL)
- {
- // There is a main loop outside of Object Tcl control, inform it
- // of new incomming file descriptor.
- (*addReadFd)(client);
- }
- }
-
- OtclRequest::OtclRequest()
- {
- }
-
- OtclRequest::~OtclRequest ()
- {
- }
-
- OtclInstanceMethodRqst::OtclInstanceMethodRqst ()
- {
- symRef = NULL;
- method = NULL;
- argc = 0;
- argv = NULL;
- }
-
- OtclInstanceMethodRqst::OtclInstanceMethodRqst (char *symRefParam,
- char *methodParam,
- long argcParam,
- char *argvParam[])
- {
- symRef = strdup(symRefParam);
- method = strdup(methodParam);
- argc = argcParam;
-
- if (argc != 0)
- {
- argv = (char**)malloc((unsigned int)argc * sizeof(char*));
- for (long l = 0; l < argc; l++)
- {
- argv[l] = strdup(argvParam[l]);
- }
- }
- else
- {
- argv = NULL;
- }
- }
-
- OtclInstanceMethodRqst::~OtclInstanceMethodRqst ()
- {
- clear();
- }
-
- void OtclInstanceMethodRqst::clear (void)
- {
- if (symRef != NULL)
- {
- free(symRef);
- }
- if (method != NULL)
- {
- free(method);
- }
- if (argv != NULL)
- {
- for (long l = 0; l < argc; l++)
- {
- free(argv[l]);
- }
- free(argv);
- }
- }
-
- int OtclInstanceMethodRqst::streamOut (OtclChannel *channel)
- {
- if (channel->streamOut(INSTANCE_METHOD_RQST) == -1)
- {
- return -1;
- }
- if (channel->streamOutNullTerminated(symRef) == -1)
- {
- return -1;
- }
- if (channel->streamOutNullTerminated(method) == -1)
- {
- return -1;
- }
- if (channel->streamOut(argc) == -1)
- {
- return -1;
- }
- for (long l = 0; l < argc; l++)
- {
- if (channel->streamOutNullTerminated(argv[l]) == -1)
- {
- return -1;
- }
- }
-
- return 0;
- }
-
- int OtclInstanceMethodRqst::streamIn (OtclChannel *channel)
- {
- clear();
- if (channel->streamInNullTerminated(symRef) == -1)
- {
- return -1;
- }
- if (channel->streamInNullTerminated(method) == -1)
- {
- return -1;
- }
- if (channel->streamIn(argc) == -1)
- {
- return -1;
- }
- if (argc != 0)
- {
- argv = (char**)malloc((unsigned int)argc * sizeof(char*));
- }
- else
- {
- argv = NULL;
- }
- for (long l = 0; l < argc; l++)
- {
- if (channel->streamInNullTerminated(argv[l]) == -1)
- {
- return -1;
- }
- }
-
- return 0;
- }
-
- int OtclInstanceMethodRqst::perform (Tcl_Interp *interp)
- {
- int returnCode;
- OtclObject *otclo = Otcl::otclPtr->giveOtclObject(symRef,interp,returnCode);
- if (otclo != NULL)
- {
- return otclo->executeMethod(interp,method,(unsigned int)argc,argv);
- }
- else
- {
- return Otcl::setTclError(interp,UNKNOWN_OBJECT_ERR,symRef);
- }
- }
-
- OtclResponse::OtclResponse ()
- {
- returnValue = TCL_OK;
- result = NULL;
- }
-
- OtclResponse::OtclResponse (int returnValueParam, Tcl_Interp *interp)
- {
- returnValue = returnValueParam;
- if (interp->result != NULL)
- {
- result = strdup(interp->result);
- }
- else
- {
- result = NULL;
- }
- }
-
- OtclResponse::OtclResponse (int returnValueParam, char *resultParam)
- {
- returnValue = returnValueParam;
- result = strdup(resultParam);
- }
-
- OtclResponse::~OtclResponse ()
- {
- clear();
- }
-
- void OtclResponse::clear (void)
- {
- if (result != NULL)
- {
- free(result);
- result = NULL;
- }
- }
-
- int OtclResponse::streamOut (OtclChannel *channel)
- {
- if (channel->streamOut(returnValue) == -1)
- {
- return -1;
- }
- return channel->streamOutNullTerminated(result);
- }
-
- int OtclResponse::streamIn (OtclChannel *channel)
- {
- clear();
- if (channel->streamIn(returnValue) == -1)
- {
- return -1;
- }
- return channel->streamInNullTerminated(result);
- }
-
- void OtclResponse::setTclInterp (Tcl_Interp *interp)
- {
- Tcl_SetResult(interp,result,TCL_VOLATILE);
- }
-
- int OtclResponse::getReturnValue (void)
- {
- return returnValue;
- }
-
- OtclRemoteObject::OtclRemoteObject (char *symRef, int &result,
- Tcl_Interp *interp)
- {
- remoteSymRef = strdup(symRef);
- char *at = strchr(symRef,'@');
- if (at != NULL)
- {
- address = strdup(at+1);
- }
- else
- {
- address = strdup("");
- }
-
- if (strcmp(address,"") == 0)
- {
- result = Otcl::setTclError(interp,NOT_REMOTE_OBJECT_ERR,symRef);
- }
- else
- {
- result = TCL_OK;
- }
- }
-
- OtclRemoteObject::~OtclRemoteObject ()
- {
- free(remoteSymRef);
- free(address);
- }
-
- int OtclRemoteObject::executeMethod (Tcl_Interp *interp, char *method,
- int argc, char *argv[])
- {
- OtclInstanceMethodRqst rqst(remoteSymRef,method,argc,argv);
-
- OtclResponse *response =
- OtclOserver::sendRequest(interp,address,&rqst);
-
- response->setTclInterp(interp);
- int returnValue = response->getReturnValue();
-
- delete response;
-
- return returnValue;
- }
-
- int OtclRemoteObject::discard (Tcl_Interp *interp, int)
- {
- OtclDeleteObjectRqst rqst(remoteSymRef);
-
- OtclResponse *response = OtclOserver::sendRequest(interp,address,&rqst);
-
- response->setTclInterp(interp);
- int returnValue = response->getReturnValue();
- delete response;
-
- delete this;
-
- return returnValue;
- }
-
- int OtclRemoteObject::discard (Tcl_Interp *interp, char *sr)
- {
- OtclDeleteObjectRqst rqst(sr);
-
- char *addr = strchr(sr,'@');
- if (addr != NULL)
- {
- addr++;
- }
- else
- {
- return Otcl::setTclError(interp,OTCL_BAD_REMOTE_OBJECT_ERR,addr);
- }
-
- OtclResponse *response = OtclOserver::sendRequest(interp,addr,&rqst);
-
- response->setTclInterp(interp);
- int returnValue = response->getReturnValue();
- delete response;
-
- return returnValue;
- }
-
- OtclDeleteObjectRqst::OtclDeleteObjectRqst ()
- {
- symRef = NULL;
- }
-
- OtclDeleteObjectRqst::OtclDeleteObjectRqst (char *sr)
- {
- symRef = strdup(sr);
- }
-
- OtclDeleteObjectRqst::~OtclDeleteObjectRqst ()
- {
- if (symRef != NULL)
- {
- free(symRef);
- }
- }
-
- int OtclDeleteObjectRqst::streamIn (OtclChannel *channel)
- {
- if (symRef != NULL)
- {
- free(symRef);
- }
-
- return channel->streamInNullTerminated(symRef);
- }
-
- int OtclDeleteObjectRqst::streamOut (OtclChannel *channel)
- {
- if (channel->streamOut(DELETE_OBJECT_RQST) == -1)
- {
- return -1;
- }
- return channel->streamOutNullTerminated(symRef);
- }
-
- int OtclDeleteObjectRqst::perform (Tcl_Interp *interp)
- {
- return Otcl::otclPtr->discard(interp,symRef,OTCL_FALSE);
- }
-
-
-
-
- OtclClassMethodRqst::OtclClassMethodRqst ()
- {
- name = NULL;
- method = NULL;
- argc = 0;
- argv = NULL;
- }
-
- OtclClassMethodRqst::OtclClassMethodRqst (char *nameParam, char *methodParam,
- long argcParam, char *argvParam[])
- {
- name = strdup(nameParam);
- method = strdup(methodParam);
- argc = argcParam;
-
- if (argc != 0)
- {
- argv = (char**)malloc((unsigned int)argc * sizeof(char*));
- for (long l = 0; l < argc; l++)
- {
- argv[l] = strdup(argvParam[l]);
- }
- }
- else
- {
- argv = NULL;
- }
- }
-
- OtclClassMethodRqst::~OtclClassMethodRqst ()
- {
- clear();
- }
-
- void OtclClassMethodRqst::clear (void)
- {
- if (name != NULL)
- {
- free(name);
- }
- if (name != NULL)
- {
- free(method);
- }
- if (argv != NULL)
- {
- for (long l = 0; l < argc; l++)
- {
- free(argv[l]);
- }
- free(argv);
- }
- }
-
- int OtclClassMethodRqst::streamOut (OtclChannel *channel)
- {
- if (channel->streamOut(CLASS_METHOD_RQST) == -1)
- {
- return -1;
- }
- if (channel->streamOutNullTerminated(name) == -1)
- {
- return -1;
- }
- if (channel->streamOutNullTerminated(method) == -1)
- {
- return -1;
- }
- if (channel->streamOut(argc) == -1)
- {
- return -1;
- }
- for (long l = 0; l < argc; l++)
- {
- if (channel->streamOutNullTerminated(argv[l]) == -1)
- {
- return -1;
- }
- }
-
- return 0;
- }
-
- int OtclClassMethodRqst::streamIn (OtclChannel *channel)
- {
- clear();
- if (channel->streamInNullTerminated(name) == -1)
- {
- return -1;
- }
- if (channel->streamInNullTerminated(method) == -1)
- {
- return -1;
- }
- if (channel->streamIn(argc) == -1)
- {
- return -1;
- }
- if (argc != 0)
- {
- argv = (char**)malloc((unsigned int)argc * sizeof(char*));
- }
- else
- {
- argv = NULL;
- }
- for (long l = 0; l < argc; l++)
- {
- if (channel->streamInNullTerminated(argv[l]) == -1)
- {
- return -1;
- }
- }
-
- return 0;
- }
-
- int OtclClassMethodRqst::perform (Tcl_Interp *interp)
- {
- // Dont like thus one, come back to it!
- char command[256];
-
- sprintf(command,"%s %s",name,method);
- for (int l = 0; l < argc; l++)
- {
- strcat(command," {");
- strcat(command,argv[l]);
- strcat(command,"}");
- }
-
- return Tcl_Eval(interp,command);
- }
-
-
-
-
-
- OtclNewObjectRqst::OtclNewObjectRqst ()
- {
- className = NULL;
- argc = 0;
- argv = NULL;
- }
-
- OtclNewObjectRqst::OtclNewObjectRqst (char *cn, long argcParam,
- char *argvParam[])
- {
- className = strdup(cn);
- argc = argcParam;
- if (argc != 0)
- {
- argv = (char**)malloc((unsigned int)argc * sizeof(char*));
- for (long l = 0; l < argc; l++)
- {
- argv[l] = strdup(argvParam[l]);
- }
- }
- }
-
- OtclNewObjectRqst::~OtclNewObjectRqst ()
- {
- if (className != NULL)
- {
- free(className);
- }
- if (argc != 0)
- {
- for (long l = 0; l < argc; l++)
- {
- free(argv[l]);
- }
- free(argv);
- }
- }
-
- int OtclNewObjectRqst::streamIn (OtclChannel *channel)
- {
- if (className != NULL)
- {
- free(className);
- }
- if (argc != 0)
- {
- for (long l = 0; l < argc; l++)
- {
- free(argv[l]);
- }
- free(argv);
- }
-
- if (channel->streamInNullTerminated(className) == -1)
- {
- return -1;
- }
- if (channel->streamIn(argc) == -1)
- {
- return -1;
- }
- if (argc != 0)
- {
- argv = (char **)malloc((unsigned int)argc * sizeof(char*));
- for (int l = 0; l < argc; l++)
- {
- if (channel->streamInNullTerminated(argv[l]) == -1)
- {
- return -1;
- }
- }
- }
-
- return 0;
- }
-
- int OtclNewObjectRqst::streamOut (OtclChannel *channel)
- {
- if (channel->streamOut(NEW_OBJECT_RQST) == -1)
- {
- return -1;
- }
- if (channel->streamOutNullTerminated(className) == -1)
- {
- return -1;
- }
- if (channel->streamOut(argc) == -1)
- {
- return -1;
- }
- if (argc != 0)
- {
- for (long l = 0; l < argc; l++)
- {
- if (channel->streamOutNullTerminated(argv[l]) == -1)
- {
- return -1;
- }
- }
- }
-
- return 0;
- }
-
- int OtclNewObjectRqst::perform (Tcl_Interp *interp)
- {
- return Otcl::otclPtr->instantiate(interp,className,(int)argc,argv);
- }
-
-
-
-
- OtclRemoteClass::OtclRemoteClass (Tcl_Interp *interp, char *n, char *a)
- {
- name = strdup(n);
- address = strdup(a);
-
- Tcl_CreateCommand(interp,name,OtclRemoteClass::classCmd,
- (ClientData)this,(Tcl_CmdDeleteProc*)NULL);
- }
-
- OtclRemoteClass::~OtclRemoteClass ()
- {
- // remove the command!
- // Tcl_DeleteCommand(interp,name); Hummmm where should this be done!
- // TO DO!
-
- free(name);
- free(address);
- }
-
- int OtclRemoteClass::instantiate (Tcl_Interp *interp, int argc, char *argv[])
- {
- OtclNewObjectRqst rqst(name,argc,argv);
-
- OtclResponse *response = OtclOserver::sendRequest(interp, address,&rqst);
-
- response->setTclInterp(interp);
- int returnValue = response->getReturnValue();
- delete response;
-
- return returnValue;
- }
-
- int OtclRemoteClass::classCmd (ClientData cd, Tcl_Interp *interp, int argc,
- char *argv[])
- {
- ARGC_MIN(2)
- {
- return Otcl::setTclError(interp,ARGS_CLASS_CMD_ERR);
- }
- OtclRemoteClass *otclc = (OtclRemoteClass*)cd;
- return otclc->classMethod(interp,argc,argv);
- }
-
- int OtclRemoteClass::classMethod (Tcl_Interp *interp, int argc, char *argv[])
- {
- ARGC_MIN(2)
- {
- return Otcl::setTclError(interp,ARGS_CLASS_METHOD_EXE_ERR);
- }
-
- OtclClassMethodRqst rqst(name,argv[1], argc-2,
- (argc == 2? NULL : &argv[2]));
-
- OtclResponse *response = OtclOserver::sendRequest(interp, address,&rqst);
-
- response->setTclInterp(interp);
- int returnValue = response->getReturnValue();
- delete response;
-
- return returnValue;
- }
-
- void OtclRemoteClass::setAddress (char *addr, char *n)
- {
- if (address != NULL)
- {
- free(address);
- }
- address = strdup(addr);
-
- if (name != NULL)
- {
- free(name);
- }
- name = strdup(n);
- }
-